home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / STOP.patch < prev   
Text File  |  1997-05-26  |  15KB  |  427 lines
  1. This patch replaces all STOP statements with calls to XSTOPX so that
  2. Fortran routines won't be able to kill Octave.
  3.  
  4. If you decide not to use the versions of the Fortran subroutines that
  5. are distributed with Octave, you might want to apply this patch (or
  6. something like it) to your sources.
  7.  
  8. John W. Eaton
  9. jwe@che.utexas.edu
  10. Department of Chemical Engineering
  11. The University of Texas at Austin
  12.  
  13.  
  14. diff -rc libcruft.orig/blas/xerbla.f libcruft/blas/xerbla.f
  15. *** libcruft.orig/blas/xerbla.f    Wed Feb 19 21:46:03 1992
  16. --- libcruft/blas/xerbla.f    Mon Jun  7 14:33:52 1993
  17. ***************
  18. *** 35,41 ****
  19.   *
  20.         WRITE (*,99999) SRNAME, INFO
  21.   *
  22. !       STOP
  23.   *
  24.   99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,
  25.        $         ' had an illegal value' )
  26. --- 35,41 ----
  27.   *
  28.         WRITE (*,99999) SRNAME, INFO
  29.   *
  30. !       CALL XSTOPX (' ')
  31.   *
  32.   99999 FORMAT ( ' ** On entry to ', A6, ' parameter number ', I2,
  33.        $         ' had an illegal value' )
  34. diff -rc libcruft.orig/dassl/xerhlt.f libcruft/dassl/xerhlt.f
  35. *** libcruft.orig/dassl/xerhlt.f    Wed Feb 19 23:46:22 1992
  36. --- libcruft/dassl/xerhlt.f    Mon Jun  7 14:34:44 1993
  37. ***************
  38. *** 33,37 ****
  39.   C***END PROLOGUE  XERHLT
  40.         CHARACTER*(*) MESSG
  41.   C***FIRST EXECUTABLE STATEMENT  XERHLT
  42. !       STOP
  43.         END
  44. --- 33,37 ----
  45.   C***END PROLOGUE  XERHLT
  46.         CHARACTER*(*) MESSG
  47.   C***FIRST EXECUTABLE STATEMENT  XERHLT
  48. !       CALL XSTOPX (MESSG)
  49.         END
  50. diff -rc libcruft.orig/misc/i1mach.f libcruft/misc/i1mach.f
  51. *** libcruft.orig/misc/i1mach.f    Tue Jul 21 22:31:59 1992
  52. --- libcruft/misc/i1mach.f    Mon Jun  7 14:36:50 1993
  53. ***************
  54. *** 523,527 ****
  55.         RETURN
  56.      10 WRITE(OUTPUT,1999) I
  57.    1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10)
  58. !       STOP
  59.         END
  60. --- 523,527 ----
  61.         RETURN
  62.      10 WRITE(OUTPUT,1999) I
  63.    1999 FORMAT(' I1MACH - I OUT OF BOUNDS',I10)
  64. !       CALL XSTOPX (' ')
  65.         END
  66. diff -rc libcruft.orig/odepack/xerrwv.f libcruft/odepack/xerrwv.f
  67. *** libcruft.orig/odepack/xerrwv.f    Wed Feb 19 23:50:24 1992
  68. --- libcruft/odepack/xerrwv.f    Mon Jun  7 14:38:00 1993
  69. ***************
  70. *** 109,114 ****
  71.    50   FORMAT(6X,15HIN ABOVE,  R1 =,D21.13,3X,4HR2 =,D21.13) 
  72.   C ABORT THE RUN IF LEVEL = 2. ------------------------------------------
  73.    100  IF (LEVEL .NE. 2) RETURN
  74. !       STOP
  75.   C----------------------- END OF SUBROUTINE XERRWV ----------------------
  76.         END 
  77. --- 109,114 ----
  78.    50   FORMAT(6X,15HIN ABOVE,  R1 =,D21.13,3X,4HR2 =,D21.13) 
  79.   C ABORT THE RUN IF LEVEL = 2. ------------------------------------------
  80.    100  IF (LEVEL .NE. 2) RETURN
  81. !       CALL XSTOPX (' ')
  82.   C----------------------- END OF SUBROUTINE XERRWV ----------------------
  83.         END 
  84. diff -rc libcruft.orig/ranlib/advnst.f libcruft/ranlib/advnst.f
  85. *** libcruft.orig/ranlib/advnst.f    Wed Apr 22 08:49:00 1992
  86. --- libcruft/ranlib/advnst.f    Mon Jun  7 15:35:37 1993
  87. ***************
  88. *** 60,66 ****
  89.         IF (qrgnin()) GO TO 10
  90.         WRITE (*,*) ' ADVNST called before random number generator ',
  91.        +  ' initialized -- abort!'
  92. !       STOP ' ADVNST called before random number generator initialized'
  93.   
  94.      10 CALL getcgn(g)
  95.   C
  96. --- 60,67 ----
  97.         IF (qrgnin()) GO TO 10
  98.         WRITE (*,*) ' ADVNST called before random number generator ',
  99.        +  ' initialized -- abort!'
  100. !       CALL XSTOPX
  101. !      + (' ADVNST called before random number generator initialized')
  102.   
  103.      10 CALL getcgn(g)
  104.   C
  105. diff -rc libcruft.orig/ranlib/genbet.f libcruft/ranlib/genbet.f
  106. *** libcruft.orig/ranlib/genbet.f    Wed Apr 22 08:49:00 1992
  107. --- libcruft/ranlib/genbet.f    Mon Jun  7 15:35:23 1993
  108. ***************
  109. *** 67,73 ****
  110.         IF (.NOT. (aa.LE.0.0.OR.bb.LE.0.0)) GO TO 10
  111.         WRITE (*,*) ' AA or BB <= 0 in GENBET - Abort!'
  112.         WRITE (*,*) ' AA: ',aa,' BB ',bb
  113. !       STOP ' AA or BB <= 0 in GENBET - Abort!'
  114.   
  115.      10 olda = aa
  116.         oldb = bb
  117. --- 67,73 ----
  118.         IF (.NOT. (aa.LE.0.0.OR.bb.LE.0.0)) GO TO 10
  119.         WRITE (*,*) ' AA or BB <= 0 in GENBET - Abort!'
  120.         WRITE (*,*) ' AA: ',aa,' BB ',bb
  121. !       CALL XSTOPX (' AA or BB <= 0 in GENBET - Abort!')
  122.   
  123.      10 olda = aa
  124.         oldb = bb
  125. diff -rc libcruft.orig/ranlib/genchi.f libcruft/ranlib/genchi.f
  126. *** libcruft.orig/ranlib/genchi.f    Wed Apr 22 08:49:00 1992
  127. --- libcruft/ranlib/genchi.f    Mon Jun  7 15:35:17 1993
  128. ***************
  129. *** 37,43 ****
  130.         IF (.NOT. (df.LE.0.0)) GO TO 10
  131.         WRITE (*,*) 'DF <= 0 in GENCHI - ABORT'
  132.         WRITE (*,*) 'Value of DF: ',df
  133. !       STOP 'DF <= 0 in GENCHI - ABORT'
  134.   
  135.      10 genchi = 2.0*gengam(1.0,df/2.0)
  136.         RETURN
  137. --- 37,43 ----
  138.         IF (.NOT. (df.LE.0.0)) GO TO 10
  139.         WRITE (*,*) 'DF <= 0 in GENCHI - ABORT'
  140.         WRITE (*,*) 'Value of DF: ',df
  141. !       CALL XSTOPX ('DF <= 0 in GENCHI - ABORT')
  142.   
  143.      10 genchi = 2.0*gengam(1.0,df/2.0)
  144.         RETURN
  145. diff -rc libcruft.orig/ranlib/genf.f libcruft/ranlib/genf.f
  146. *** libcruft.orig/ranlib/genf.f    Wed Apr 22 08:49:00 1992
  147. --- libcruft/ranlib/genf.f    Mon Jun  7 15:35:07 1993
  148. ***************
  149. *** 44,50 ****
  150.         IF (.NOT. (dfn.LE.0.0.OR.dfd.LE.0.0)) GO TO 10
  151.         WRITE (*,*) 'Degrees of freedom nonpositive in GENF - abort!'
  152.         WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd
  153. !       STOP 'Degrees of freedom nonpositive in GENF - abort!'
  154.   
  155.      10 xnum = genchi(dfn)/dfn
  156.   C      GENF = ( GENCHI( DFN ) / DFN ) / ( GENCHI( DFD ) / DFD )
  157. --- 44,50 ----
  158.         IF (.NOT. (dfn.LE.0.0.OR.dfd.LE.0.0)) GO TO 10
  159.         WRITE (*,*) 'Degrees of freedom nonpositive in GENF - abort!'
  160.         WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd
  161. !       CALL XSTOPX ('Degrees of freedom nonpositive in GENF - abort!')
  162.   
  163.      10 xnum = genchi(dfn)/dfn
  164.   C      GENF = ( GENCHI( DFN ) / DFN ) / ( GENCHI( DFD ) / DFD )
  165. diff -rc libcruft.orig/ranlib/gennch.f libcruft/ranlib/gennch.f
  166. *** libcruft.orig/ranlib/gennch.f    Wed Apr 22 08:49:00 1992
  167. --- libcruft/ranlib/gennch.f    Mon Jun  7 15:34:58 1993
  168. ***************
  169. *** 48,54 ****
  170.         IF (.NOT. (df.LE.1.0.OR.xnonc.LT.0.0)) GO TO 10
  171.         WRITE (*,*) 'DF <= 1 or XNONC < 0 in GENNCH - ABORT'
  172.         WRITE (*,*) 'Value of DF: ',df,' Value of XNONC',xnonc
  173. !       STOP 'DF <= 1 or XNONC < 0 in GENNCH - ABORT'
  174.   
  175.      10 gennch = genchi(df-1.0) + gennor(sqrt(xnonc),1.0)**2
  176.         RETURN
  177. --- 48,54 ----
  178.         IF (.NOT. (df.LE.1.0.OR.xnonc.LT.0.0)) GO TO 10
  179.         WRITE (*,*) 'DF <= 1 or XNONC < 0 in GENNCH - ABORT'
  180.         WRITE (*,*) 'Value of DF: ',df,' Value of XNONC',xnonc
  181. !       CALL XSTOPX ('DF <= 1 or XNONC < 0 in GENNCH - ABORT')
  182.   
  183.      10 gennch = genchi(df-1.0) + gennor(sqrt(xnonc),1.0)**2
  184.         RETURN
  185. diff -rc libcruft.orig/ranlib/gennf.f libcruft/ranlib/gennf.f
  186. *** libcruft.orig/ranlib/gennf.f    Wed Apr 22 08:49:00 1992
  187. --- libcruft/ranlib/gennf.f    Mon Jun  7 15:56:26 1993
  188. ***************
  189. *** 56,62 ****
  190.         WRITE (*,*) '(3) Noncentrality parameter < 0.0'
  191.         WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd,'XNONC value: ',
  192.        +  xnonc
  193. !       STOP 'Degrees of freedom or noncent param our of range in GENNF'
  194.   
  195.      10 xnum = gennch(dfn,xnonc)/dfn
  196.   C      GENNF = ( GENNCH( DFN, XNONC ) / DFN ) / ( GENCHI( DFD ) / DFD )
  197. --- 56,63 ----
  198.         WRITE (*,*) '(3) Noncentrality parameter < 0.0'
  199.         WRITE (*,*) 'DFN value: ',dfn,'DFD value: ',dfd,'XNONC value: ',
  200.        +  xnonc
  201. !       CALL XSTOPX
  202. !      + ('Degrees of freedom or noncent param our of range in GENNF')
  203.   
  204.      10 xnum = gennch(dfn,xnonc)/dfn
  205.   C      GENNF = ( GENNCH( DFN, XNONC ) / DFN ) / ( GENCHI( DFD ) / DFD )
  206. diff -rc libcruft.orig/ranlib/genunf.f libcruft/ranlib/genunf.f
  207. *** libcruft.orig/ranlib/genunf.f    Wed Apr 22 08:49:00 1992
  208. --- libcruft/ranlib/genunf.f    Mon Jun  7 15:34:37 1993
  209. ***************
  210. *** 33,39 ****
  211.         IF (.NOT. (low.GT.high)) GO TO 10
  212.         WRITE (*,*) 'LOW > HIGH in GENUNF: LOW ',low,' HIGH: ',high
  213.         WRITE (*,*) 'Abort'
  214. !       STOP 'LOW > High in GENUNF - Abort'
  215.   
  216.      10 genunf = low + (high-low)*ranf()
  217.   
  218. --- 33,39 ----
  219.         IF (.NOT. (low.GT.high)) GO TO 10
  220.         WRITE (*,*) 'LOW > HIGH in GENUNF: LOW ',low,' HIGH: ',high
  221.         WRITE (*,*) 'Abort'
  222. !       CALL XSTOPX ('LOW > High in GENUNF - Abort')
  223.   
  224.      10 genunf = low + (high-low)*ranf()
  225.   
  226. diff -rc libcruft.orig/ranlib/getcgn.f libcruft/ranlib/getcgn.f
  227. *** libcruft.orig/ranlib/getcgn.f    Wed Apr 22 08:49:00 1992
  228. --- libcruft/ranlib/getcgn.f    Mon Jun  7 15:34:31 1993
  229. ***************
  230. *** 47,53 ****
  231.         IF (.NOT. (g.LT.0.OR.g.GT.numg)) GO TO 10
  232.         WRITE (*,*) ' Generator number out of range in SETCGN:',
  233.        +  ' Legal range is 1 to ',numg,' -- ABORT!'
  234. !       STOP ' Generator number out of range in SETCGN'
  235.   
  236.      10 curntg = g
  237.         RETURN
  238. --- 47,53 ----
  239.         IF (.NOT. (g.LT.0.OR.g.GT.numg)) GO TO 10
  240.         WRITE (*,*) ' Generator number out of range in SETCGN:',
  241.        +  ' Legal range is 1 to ',numg,' -- ABORT!'
  242. !       CALL XSTOPX (' Generator number out of range in SETCGN')
  243.   
  244.      10 curntg = g
  245.         RETURN
  246. diff -rc libcruft.orig/ranlib/getsd.f libcruft/ranlib/getsd.f
  247. *** libcruft.orig/ranlib/getsd.f    Wed Apr 22 08:49:01 1992
  248. --- libcruft/ranlib/getsd.f    Mon Jun  7 15:34:23 1993
  249. ***************
  250. *** 62,68 ****
  251.         IF (qrgnin()) GO TO 10
  252.         WRITE (*,*) ' GETSD called before random number generator ',
  253.        +  ' initialized -- abort!'
  254. !       STOP ' GETSD called before random number generator initialized'
  255.   
  256.      10 CALL getcgn(g)
  257.         iseed1 = cg1(g)
  258. --- 62,69 ----
  259.         IF (qrgnin()) GO TO 10
  260.         WRITE (*,*) ' GETSD called before random number generator ',
  261.        +  ' initialized -- abort!'
  262. !       CALL XSTOPX
  263. !      + (' GETSD called before random number generator initialized')
  264.   
  265.      10 CALL getcgn(g)
  266.         iseed1 = cg1(g)
  267. diff -rc libcruft.orig/ranlib/ignuin.f libcruft/ranlib/ignuin.f
  268. *** libcruft.orig/ranlib/ignuin.f    Wed Apr 22 08:49:01 1992
  269. --- libcruft/ranlib/ignuin.f    Mon Jun  7 15:34:09 1993
  270. ***************
  271. *** 94,100 ****
  272.     100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high
  273.         WRITE (*,*) ' Abort on Fatal ERROR'
  274.         IF (.NOT. (err.EQ.1)) GO TO 110
  275. !       STOP 'LOW > HIGH in IGNUIN'
  276.   
  277.         GO TO 120
  278.   
  279. --- 94,100 ----
  280.     100 WRITE (*,*) ' LOW: ',low,' HIGH: ',high
  281.         WRITE (*,*) ' Abort on Fatal ERROR'
  282.         IF (.NOT. (err.EQ.1)) GO TO 110
  283. !       CALL XSTOPX ('LOW > HIGH in IGNUIN')
  284.   
  285.         GO TO 120
  286.   
  287. diff -rc libcruft.orig/ranlib/initgn.f libcruft/ranlib/initgn.f
  288. *** libcruft.orig/ranlib/initgn.f    Wed Apr 22 08:49:01 1992
  289. --- libcruft/ranlib/initgn.f    Mon Jun  7 15:34:03 1993
  290. ***************
  291. *** 66,72 ****
  292.         IF (qrgnin()) GO TO 10
  293.         WRITE (*,*) ' INITGN called before random number generator ',
  294.        +  ' initialized -- abort!'
  295. !       STOP ' INITGN called before random number generator initialized'
  296.   
  297.      10 CALL getcgn(g)
  298.         IF ((-1).NE. (isdtyp)) GO TO 20
  299. --- 66,73 ----
  300.         IF (qrgnin()) GO TO 10
  301.         WRITE (*,*) ' INITGN called before random number generator ',
  302.        +  ' initialized -- abort!'
  303. !       CALL XSTOPX
  304. !      + (' INITGN called before random number generator initialized')
  305.   
  306.      10 CALL getcgn(g)
  307.         IF ((-1).NE. (isdtyp)) GO TO 20
  308. diff -rc libcruft.orig/ranlib/mltmod.f libcruft/ranlib/mltmod.f
  309. *** libcruft.orig/ranlib/mltmod.f    Wed Apr 22 08:49:01 1992
  310. --- libcruft/ranlib/mltmod.f    Mon Jun  7 15:33:49 1993
  311. ***************
  312. *** 39,45 ****
  313.         WRITE (*,*) ' A, M, S out of order in MLTMOD - ABORT!'
  314.         WRITE (*,*) ' A = ',a,' S = ',s,' M = ',m
  315.         WRITE (*,*) ' MLTMOD requires: 0 < A < M; 0 < S < M'
  316. !       STOP ' A, M, S out of order in MLTMOD - ABORT!'
  317.   
  318.      10 IF (.NOT. (a.LT.h)) GO TO 20
  319.         a0 = a
  320. --- 39,45 ----
  321.         WRITE (*,*) ' A, M, S out of order in MLTMOD - ABORT!'
  322.         WRITE (*,*) ' A = ',a,' S = ',s,' M = ',m
  323.         WRITE (*,*) ' MLTMOD requires: 0 < A < M; 0 < S < M'
  324. !       CALL XSTOPX (' A, M, S out of order in MLTMOD - ABORT!')
  325.   
  326.      10 IF (.NOT. (a.LT.h)) GO TO 20
  327.         a0 = a
  328. diff -rc libcruft.orig/ranlib/setant.f libcruft/ranlib/setant.f
  329. *** libcruft.orig/ranlib/setant.f    Wed Apr 22 08:49:01 1992
  330. --- libcruft/ranlib/setant.f    Mon Jun  7 15:33:36 1993
  331. ***************
  332. *** 65,71 ****
  333.         IF (qrgnin()) GO TO 10
  334.         WRITE (*,*) ' SETANT called before random number generator ',
  335.        +  ' initialized -- abort!'
  336. !       STOP ' SETANT called before random number generator initialized'
  337.   
  338.      10 CALL getcgn(g)
  339.         qanti(g) = qvalue
  340. --- 65,72 ----
  341.         IF (qrgnin()) GO TO 10
  342.         WRITE (*,*) ' SETANT called before random number generator ',
  343.        +  ' initialized -- abort!'
  344. !       CALL XSTOPX
  345. !      + (' SETANT called before random number generator initialized')
  346.   
  347.      10 CALL getcgn(g)
  348.         qanti(g) = qvalue
  349. diff -rc libcruft.orig/ranlib/setgmn.f libcruft/ranlib/setgmn.f
  350. *** libcruft.orig/ranlib/setgmn.f    Wed Apr 22 08:49:01 1992
  351. --- libcruft/ranlib/setgmn.f    Mon Jun  7 15:33:21 1993
  352. ***************
  353. *** 55,61 ****
  354.         IF (.NOT. (p.LE.0)) GO TO 10
  355.         WRITE (*,*) 'P nonpositive in SETGMN'
  356.         WRITE (*,*) 'Value of P: ',p
  357. !       STOP 'P nonpositive in SETGMN'
  358.   
  359.      10 parm(1) = p
  360.   C
  361. --- 55,61 ----
  362.         IF (.NOT. (p.LE.0)) GO TO 10
  363.         WRITE (*,*) 'P nonpositive in SETGMN'
  364.         WRITE (*,*) 'Value of P: ',p
  365. !       CALL XSTOPX ('P nonpositive in SETGMN')
  366.   
  367.      10 parm(1) = p
  368.   C
  369. ***************
  370. *** 70,76 ****
  371.         CALL spofa(covm,p,p,info)
  372.         IF (.NOT. (info.NE.0)) GO TO 30
  373.         WRITE (*,*) ' COVM not positive definite in SETGMN'
  374. !       STOP ' COVM not positive definite in SETGMN'
  375.   
  376.      30 icount = p + 1
  377.   C
  378. --- 70,76 ----
  379.         CALL spofa(covm,p,p,info)
  380.         IF (.NOT. (info.NE.0)) GO TO 30
  381.         WRITE (*,*) ' COVM not positive definite in SETGMN'
  382. !       CALL XSTOPX (' COVM not positive definite in SETGMN')
  383.   
  384.      30 icount = p + 1
  385.   C
  386. diff -rc libcruft.orig/ranlib/setsd.f libcruft/ranlib/setsd.f
  387. *** libcruft.orig/ranlib/setsd.f    Wed Apr 22 08:49:01 1992
  388. --- libcruft/ranlib/setsd.f    Mon Jun  7 15:32:58 1993
  389. ***************
  390. *** 62,68 ****
  391.         IF (qrgnin()) GO TO 10
  392.         WRITE (*,*) ' SETSD called before random number generator ',
  393.        +  ' initialized -- abort!'
  394. !       STOP ' SETSD called before random number generator initialized'
  395.   
  396.      10 CALL getcgn(g)
  397.         ig1(g) = iseed1
  398. --- 62,69 ----
  399.         IF (qrgnin()) GO TO 10
  400.         WRITE (*,*) ' SETSD called before random number generator ',
  401.        +  ' initialized -- abort!'
  402. !       CALL XSTOPX
  403. !      + (' SETSD called before random number generator initialized')
  404.   
  405.      10 CALL getcgn(g)
  406.         ig1(g) = iseed1
  407. diff -rc libcruft.orig/villad/vilerr.f libcruft/villad/vilerr.f
  408. *** libcruft.orig/villad/vilerr.f    Wed Dec  2 21:54:57 1992
  409. --- libcruft/villad/vilerr.f    Mon Jun  7 15:55:08 1993
  410. ***************
  411. *** 80,86 ****
  412.   C
  413.   C -- PROGRAM EXECUTION TERMINATES HERE
  414.   C
  415. !         STOP
  416.   C
  417.         ELSE
  418.         END IF
  419. --- 80,86 ----
  420.   C
  421.   C -- PROGRAM EXECUTION TERMINATES HERE
  422.   C
  423. !         CALL XSTOPX (' ')
  424.   C
  425.         ELSE
  426.         END IF
  427.